home *** CD-ROM | disk | FTP | other *** search
/ Light ROM Gold / Light ROM Gold.iso / arexx / modeler / gears.lwm < prev    next >
Text File  |  1995-03-23  |  3KB  |  145 lines
  1. /* CMD: Gear
  2.  * Make gears of user defined size in Modeler
  3.  * By Steve Koren Copyright ⌐ 1994 Steve Koren.
  4.  */
  5.  
  6. /* -- See if we have any parameters up front ------------------------------ */
  7.  
  8. arg name teeth rad_inner rad_outer thickness Ax
  9.  
  10. if name="" then name="Gear"
  11. else name=strip(name)
  12.  
  13. if teeth=""     then teeth=20
  14. if rad_inner="" then rad_inner=.4
  15. if rad_outer="" then rad_outer=.5
  16. if thickness="" then thickness=.1
  17. if Ax=""        then Ax='Y'
  18. cen = 0 0 0
  19. flist = Angular Smooth
  20.  
  21. /* -- Load proper function libraries -------------------------------------- */
  22.  
  23. signal on error
  24. signal on syntax
  25.  
  26. call addlib "rexxsupport.library", 0, -30, 0
  27. MATHLIB="rexxmathlib.library"
  28. IF POS(MATHLIB , SHOW('L')) = 0 THEN
  29.   IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
  30.         call notify(1,"!Can't find "MATHLIB)
  31.         exit
  32.         END
  33.  
  34. libadd = addlib("LWModelerARexx.port",0)
  35.  
  36.  
  37. /* -- Generate our requester ---------------------------------------------- */
  38.  
  39. call req_begin "Gear Generator"
  40.  
  41. AxId    = req_addcontrol("Axis", "CH",'X Y Z')
  42. TeethID = req_addcontrol("Teeth",'N')
  43. InnerID = req_addcontrol("Inner Radius",'N',1)
  44. OuterID = req_addcontrol("Outer Radius",'N',1)
  45. ThickID = req_addcontrol("Thickness",'N',1)
  46. TypeID  = req_addcontrol('Type:','CV',FList)
  47. CenID   = req_addcontrol("Center",'V',1)
  48. SurfId  = req_addcontrol("Surface",'R')
  49.  
  50. call req_setval AxId, 3
  51. call req_setval TeethID, 20,20
  52. call req_setval InnerID, 1,1
  53. call req_setval OuterID, 1.1,1.1
  54. call req_setval ThickID, .1,.1
  55. call req_setval CenID,0
  56. call req_setval TypeID,1
  57.  
  58. /* -- Post our requester and ask for input -------------------------------- */
  59.  
  60. if (~req_post()) then do
  61.     call req_end
  62.     exit
  63. end
  64.  
  65. teeth     = req_getval(TeethId)
  66. rad_inner = req_getval(InnerId)
  67. rad_outer = req_getval(OuterId)
  68. thickness = req_getval(ThickId)
  69. Ax        = req_getval(AxId)
  70. name      = req_getval(SurfId)
  71. cen       = req_getval(CenId)
  72. gtype     = req_getval(TypeID)
  73.  
  74. call req_end()
  75.  
  76. t_ang = 360.0 / teeth / 57.2957794
  77.  
  78. /* -- Generate a polygon -------------------------------------------------- */
  79.  
  80. vl=""
  81. cx = word(cen,1)
  82. cy = word(cen,2)
  83. cz = word(cen,3) - thickness/2
  84.  
  85. call ADD_BEGIN()
  86.   call SURFACE("___GEAR")
  87.  
  88.   do tooth=0 to teeth-1
  89.     a1  = t_ang * tooth
  90.     a2  = a1 + (t_ang*3/6)
  91.     a3  = a1 + (t_ang*4/6)
  92.     a4  = a1 + (t_ang*5/6)
  93.  
  94.     vl = vl add_point((rad_inner * sin(a1)+cx) (rad_inner * cos(a1)+cy) cz)
  95.     vl = vl add_point((rad_inner * sin(a2)+cx) (rad_inner * cos(a2)+cy) cz)
  96.     vl = vl add_point((rad_outer * sin(a3)+cx) (rad_outer * cos(a3)+cy) cz)
  97.     vl = vl add_point((rad_outer * sin(a4)+cx) (rad_outer * cos(a4)+cy) cz)
  98.  
  99.   end
  100.  
  101.   if gtype=2 then do
  102.     call ADD_CURVE vl
  103.     end
  104.   else do
  105.     call ADD_POLYGON vl
  106.     end
  107.  
  108. call ADD_END()
  109.  
  110. /* -- Make it part of the right surface ----------------------------------- */
  111.  
  112. call SEL_MODE(USER)
  113. call SEL_POLYGON(CLEAR, NVGT, 1)
  114. call SEL_POLYGON(SET,SURFACE, "___GEAR")
  115.  
  116. if gtype=2 then do
  117.   call FREEZECURVES()
  118. end
  119.  
  120. /* -- Generate proper thinkness ------------------------------------------- */
  121.  
  122. call EXTRUDE(Z, thickness, 1)
  123.  
  124. call CHANGESURFACE(name)
  125.  
  126. /* -- Rotate the new gear into the proper orientation --------------------- */
  127.  
  128. if Ax=1 then do       /* X */
  129.   call ROTATE(90, X, cen)
  130.   end
  131. else if Ax=2 then do  /* Y */
  132.   call ROTATE(90, Y, cen)
  133.   end
  134. else if Ax=3 then do  /* Z */
  135.   end
  136.  
  137.  
  138. exit
  139.  
  140. syntax:
  141. error:
  142.   call end_all
  143.     t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  144.     exit
  145.